home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 2 / Atari Mega Archive CD - Volume 2.iso / 8bit / cislib_a / entryi.act < prev    next >
Text File  |  1995-04-22  |  3KB  |  194 lines
  1. ;************************************
  2. ;*                                  *
  3. ;*(C)Copyright 1986 by Paul B. Loux *
  4. ;*                                  *
  5. ;* These routines are in the public *
  6. ;* domain,  and  are not to be sold *
  7. ;* for a profit. They may be freely *
  8. ;* distributed, provided  that this *
  9. ;* header remains in place. Use and *
  10. ;* enjoy! PBL, CIS 72337,2073.      *
  11. ;*                                  *
  12. ;************************************
  13. ;
  14. ;  CARD FUNC EntryI()
  15. ;
  16. ;  Universal integer-entry routine,
  17. ;  requires PROC EntryS(), the
  18. ;  universal string entry routine.
  19. ;  Includes range check, a null-
  20. ;  entry ok flag, and uses the
  21. ;  the same XIT flag as ENTRYS.
  22. ;
  23. ;  This routine takes input from
  24. ;  K: in string form (through
  25. ;  EntryS) and checks for legal
  26. ;  value (<=65535) and other useful
  27. ;  features before converting to
  28. ;  an actual INT value.
  29. ;
  30. ;  Use of EntryS allows the same
  31. ;  user interface (ESC and ^-Z
  32. ;  handling, timeouts, etc.)
  33. ;
  34. ;  Parameters are self-explanatory;
  35. ;  minval and maxval are the range
  36. ;  limits for acceptable response
  37. ;  (limted to +/-32767 of course);
  38. ;  the XIT and nullok flags are 1
  39. ;  for yes and 0 for no.
  40. ;
  41. ;************************************
  42. ;
  43.  INCLUDE "ENTRYS.ACT"
  44. ;
  45. ;************************************
  46.  
  47. INT FUNC EntryI(BYTE col,row
  48.                 INT minval,maxval
  49.                 BYTE nullok,
  50.                 xeq,xit
  51.                 BYTE POINTER err_ptr)
  52.  
  53. BYTE ARRAY u_limit(0)="32767",
  54.            l_limit(0)="-32767",
  55.            field(0)="......" 
  56. BYTE fldlen=field
  57.  
  58. BYTE accept,min,max,typec
  59. INT chk,tmp
  60. INT value,tmpval
  61.  
  62. CARD temp,minchk,maxchk,offset
  63.  
  64. min=0 
  65. IF nullok=0 THEN
  66.  IF minval<0 THEN
  67.   temp=-minval
  68.   min==+1
  69.  ELSE
  70.   temp=minval
  71.  FI
  72.  IF temp>0 THEN min==+1 FI
  73.  IF temp>10 THEN min==+1 FI
  74.  IF temp>100 THEN min==+1 FI
  75.  IF temp>1000 THEN min==+1 FI
  76.  IF temp>10000 THEN min==+1 FI
  77. FI
  78.  
  79. max=1
  80. IF maxval<0 THEN
  81.  temp=-maxval
  82.  max==+1
  83. ELSE
  84.  temp=maxval
  85. FI
  86. IF temp>0 THEN max==+1 FI
  87. IF temp>10 THEN max==+1 FI
  88. IF temp>100 THEN max==+1 FI
  89. IF temp>1000 THEN max==+1 FI
  90. IF temp>10000 THEN max==+1 FI
  91.  
  92. IF max<min THEN
  93.  tmp=max
  94.  max=min
  95.  min=tmp
  96. FI
  97.  
  98. typec=3               ; signed int
  99. accept=0
  100. chk=0
  101.  
  102. DO
  103.  ENTRYS(field,min,max,typec,xit,
  104.         col,row,err_ptr)
  105.        
  106.  IF err_ptr^#0 THEN RETURN(0) FI
  107. ;calling routine does error handling
  108.  
  109.  IF fldlen=0 THEN
  110.   field(1)='0
  111.   field(0)=1
  112.  FI
  113.  
  114.  IF fldlen=6 THEN
  115.   chk=SCOMPARE(field,l_limit)
  116.  ELSEIF fldlen=5 THEN
  117.   IF field(1)#45 THEN  ;'-
  118.    chk=SCOMPARE(field,u_limit)
  119.   FI
  120.  FI
  121.  
  122.  IF chk>0 THEN
  123.   MSG(7)
  124.  ELSE
  125.   value=VALI(field)
  126.   IF minval<0 THEN
  127.     offset=-minval
  128.     minchk=0
  129.     maxval==+offset
  130.     maxchk=maxval
  131.     tmpval=value
  132.     tmpval==+offset
  133.     IF tmpval<0 THEN
  134.      tmpval=maxval+1
  135.     FI
  136.     temp=tmpval
  137.   ELSE
  138.     temp=value
  139.     maxchk=maxval
  140.     minchk=minval
  141.   FI
  142.   IF temp<minchk or temp>maxchk
  143.    THEN MSG(7)
  144.   ELSE accept=1
  145.   FI
  146.  FI
  147.  
  148. UNTIL accept
  149. OD
  150.  
  151. RETURN(value)
  152.  
  153. ;************************************
  154. ;
  155. ; Example of use of EntryC()
  156.  
  157. PROC Test4()
  158.  
  159. BYTE x,y,nullflg
  160. INT min,max,value
  161. BYTE errcde
  162. BYTE POINTER err_ptr
  163.  
  164. errcde=0
  165. err_ptr=@errcde
  166.  
  167. min=-20000
  168. max=-1000
  169.  
  170. nullflg=0
  171. x=19  y=7
  172.  
  173. PUT(125)
  174. POSITION(5,5)
  175. PUTE()
  176. PRINTE("Enter a number between ")
  177. PRINTI(min)
  178. PRINT(" and ")
  179. PRINTI(max)
  180. PRINT(": ")
  181.  
  182. value=EntryI(x,y,min,max,nullflg,
  183.              0,0,err_ptr)
  184.  
  185. POSITION(5,17)
  186. PUTE()
  187. PRINTIE(value)
  188. PRINTE("Done...")
  189.  
  190. RETURN
  191.  
  192.  
  193.  
  194.